home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / x2p / find2perl < prev    next >
Encoding:
Text File  |  1996-07-07  |  12.0 KB  |  576 lines  |  [TEXT/MPS ]
  1. Perl -Sx "{0}" {"Parameters"}; Exit {Status}
  2. #!perl
  3.     eval 'exec perl -S $0 "$@"'
  4.     if 0;
  5. $startperl = 'Perl -Sx "{0}" {"Parameters"}; Exit {Status}
  6. #!perl';
  7. # 
  8. # Modified September 26, 1993 to provide proper handling of years after 1999
  9. #   Tom Link <tml+@pitt.edu>
  10. #   University of Pittsburgh
  11.  
  12. while ($ARGV[0] =~ /^[^-!(]/) {
  13.     push(@roots, shift);
  14. }
  15. if ($^O eq "MacOS") {
  16.     @roots = (':') unless @roots;
  17. } else {
  18.     @roots = ('.') unless @roots;
  19. }
  20. for (@roots) { $_ = "e($_); }
  21. $roots = join(',', @roots);
  22.  
  23. $indent = 1;
  24.  
  25. while (@ARGV) {
  26.     $_ = shift;
  27.     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  28.     if ($_ eq '(') {
  29.     $out .= &tab . "(\n";
  30.     $indent++;
  31.     next;
  32.     }
  33.     elsif ($_ eq ')') {
  34.     $indent--;
  35.     $out .= &tab . ")";
  36.     }
  37.     elsif ($_ eq '!') {
  38.     $out .= &tab . "!";
  39.     next;
  40.     }
  41.     elsif ($_ eq 'name') {
  42.     $out .= &tab;
  43.     $pat = &fileglob_to_re(shift);
  44.     $out .= '/' . $pat . "/";
  45.     }
  46.     elsif ($_ eq 'perm') {
  47.     $onum = shift;
  48.     die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  49.     if ($onum =~ s/^-//) {
  50.         $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  51.         $out .= &tab . "((\$mode & $onum) == $onum)";
  52.     }
  53.     else {
  54.         $onum = '0' . $onum unless $onum =~ /^0/;
  55.         $out .= &tab . "((\$mode & 0777) == $onum)";
  56.     }
  57.     }
  58.     elsif ($_ eq 'type') {
  59.     ($filetest = shift) =~ tr/s/S/;
  60.     $out .= &tab . "-$filetest _";
  61.     }
  62.     elsif ($_ eq 'print') {
  63.     $out .= &tab . 'print("$name\n")';
  64.     }
  65.     elsif ($_ eq 'print0') {
  66.     $out .= &tab . 'print("$name\0")';
  67.     }
  68.     elsif ($_ eq 'fstype') {
  69.     $out .= &tab;
  70.     $type = shift;
  71.     if ($type eq 'nfs')
  72.         { $out .= '($dev < 0)'; }
  73.     else
  74.         { $out .= '($dev >= 0)'; }
  75.     }
  76.     elsif ($_ eq 'user') {
  77.     $uname = shift;
  78.     $out .= &tab . "(\$uid == \$uid{'$uname'})";
  79.     $inituser++;
  80.     }
  81.     elsif ($_ eq 'group') {
  82.     $gname = shift;
  83.     $out .= &tab . "(\$gid == \$gid{'$gname'})";
  84.     $initgroup++;
  85.     }
  86.     elsif ($_ eq 'nouser') {
  87.     $out .= &tab . '!defined $uid{$uid}';
  88.     $inituser++;
  89.     }
  90.     elsif ($_ eq 'nogroup') {
  91.     $out .= &tab . '!defined $gid{$gid}';
  92.     $initgroup++;
  93.     }
  94.     elsif ($_ eq 'links') {
  95.     $out .= &tab . '($nlink ' . &n(shift);
  96.     }
  97.     elsif ($_ eq 'inum') {
  98.     $out .= &tab . '($ino ' . &n(shift);
  99.     }
  100.     elsif ($_ eq 'size') {
  101.     $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
  102.     }
  103.     elsif ($_ eq 'atime') {
  104.     $out .= &tab . '(int(-A _) ' . &n(shift);
  105.     }
  106.     elsif ($_ eq 'mtime') {
  107.     $out .= &tab . '(int(-M _) ' . &n(shift);
  108.     }
  109.     elsif ($_ eq 'ctime') {
  110.     $out .= &tab . '(int(-C _) ' . &n(shift);
  111.     }
  112.     elsif ($_ eq 'exec') {
  113.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  114.     shift;
  115.     $_ = "@cmd";
  116.     if (m#^(/bin/)?rm -f {}$#) {
  117.         if (!@ARGV) {
  118.         $out .= &tab . 'unlink($_)';
  119.         }
  120.         else {
  121.         $out .= &tab . '(unlink($_) || 1)';
  122.         }
  123.     }
  124.     elsif (m#^(/bin/)?rm {}$#) {
  125.         $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  126.     }
  127.     else {
  128.         for (@cmd) { s/'/\\'/g; }
  129.         $" = "','";
  130.         $out .= &tab . "&exec(0, '@cmd')";
  131.         $" = ' ';
  132.         $initexec++;
  133.     }
  134.     }
  135.     elsif ($_ eq 'ok') {
  136.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  137.     shift;
  138.     for (@cmd) { s/'/\\'/g; }
  139.     $" = "','";
  140.     $out .= &tab . "&exec(1, '@cmd')";
  141.     $" = ' ';
  142.     $initexec++;
  143.     }
  144.     elsif ($_ eq 'prune') {
  145.     $out .= &tab . '($prune = 1)';
  146.     }
  147.     elsif ($_ eq 'xdev') {
  148.     $out .= &tab . '!($prune |= ($dev != $topdev))';
  149.     }
  150.     elsif ($_ eq 'newer') {
  151.     $out .= &tab;
  152.     $file = shift;
  153.     $newername = 'AGE_OF' . $file;
  154.     $newername =~ s/[^\w]/_/g;
  155.     $newername = '$' . $newername;
  156.     $out .= "(-M _ < $newername)";
  157.     $initnewer .= "$newername = -M " . "e($file) . ";\n";
  158.     }
  159.     elsif ($_ eq 'eval') {
  160.     $prog = "e(shift);
  161.     $out .= &tab . "eval $prog";
  162.     }
  163.     elsif ($_ eq 'depth') {
  164.     $depth++;
  165.     next;
  166.     }
  167.     elsif ($_ eq 'ls') {
  168.     $out .= &tab . "&ls";
  169.     $initls++;
  170.     }
  171.     elsif ($_ eq 'tar') {
  172.     $out .= &tab;
  173.     die "-tar must have a filename argument\n" unless @ARGV;
  174.     $file = shift;
  175.     $fh = 'FH' . $file;
  176.     $fh =~ s/[^\w]/_/g;
  177.     $out .= "&tar($fh)";
  178.     $file = '>' . $file;
  179.     $initfile .= "open($fh, " . "e($file) .
  180.       qq{) || die "Can't open $fh: \$!\\n";\n};
  181.     $inittar++;
  182.     $flushall = "\n&tflushall;\n";
  183.     }
  184.     elsif (/^n?cpio$/) {
  185.     $depth++;
  186.     $out .= &tab;
  187.     die "-$_ must have a filename argument\n" unless @ARGV;
  188.     $file = shift;
  189.     $fh = 'FH' . $file;
  190.     $fh =~ s/[^\w]/_/g;
  191.     $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  192.     $file = '>' . $file;
  193.     $initfile .= "open($fh, " . "e($file) .
  194.       qq{) || die "Can't open $fh: \$!\\n";\n};
  195.     $initcpio++;
  196.     $flushall = "\n&flushall;\n";
  197.     }
  198.     else {
  199.     die "Unrecognized switch: -$_\n";
  200.     }
  201.     if (@ARGV) {
  202.     if ($ARGV[0] eq '-o') {
  203.         { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  204.         $statdone = 0 if $indent == 1 && $delayedstat;
  205.         $saw_or++;
  206.         shift;
  207.     }
  208.     else {
  209.         $out .= " &&" unless $ARGV[0] eq ')';
  210.         $out .= "\n";
  211.         shift if $ARGV[0] eq '-a';
  212.     }
  213.     }
  214. }
  215.  
  216. print <<"END";
  217. $startperl
  218.  
  219. eval 'exec perl -S \$0 \${1+"\$@"}'
  220.     if \$running_under_some_shell;
  221.  
  222. END
  223.  
  224. if ($initls) {
  225.     print <<'END';
  226. @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
  227. @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
  228.  
  229. END
  230. }
  231.  
  232. if ($inituser || $initls) {
  233.     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
  234.     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
  235.     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
  236.     print "}\n\n";
  237. }
  238.  
  239. if ($initgroup || $initls) {
  240.     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
  241.     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
  242.     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
  243.     print "}\n\n";
  244. }
  245.  
  246. print $initnewer, "\n" if $initnewer;
  247.  
  248. print $initfile, "\n" if $initfile;
  249.  
  250. $find = $depth ? "finddepth" : "find";
  251. print <<"END";
  252. require "$find.pl";
  253.  
  254. # Traverse desired filesystems
  255.  
  256. &$find($roots);
  257. $flushall
  258. exit;
  259.  
  260. sub wanted {
  261. $out;
  262. }
  263.  
  264. END
  265.  
  266. if ($initexec) {
  267.     print <<'END';
  268. sub exec {
  269.     local($ok, @cmd) = @_;
  270.     foreach $word (@cmd) {
  271.     $word =~ s#{}#$name#g;
  272.     }
  273.     if ($ok) {
  274.     local($old) = select(STDOUT);
  275.     $| = 1;
  276.     print "@cmd";
  277.     select($old);
  278.     return 0 unless <STDIN> =~ /^y/;
  279.     }
  280.     chdir $cwd;        # sigh
  281.     system @cmd;
  282.     chdir $dir;
  283.     return !$?;
  284. }
  285.  
  286. END
  287. }
  288.  
  289. if ($initls) {
  290.     print <<'END';
  291. sub ls {
  292.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
  293.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  294.  
  295.     $pname = $name;
  296.  
  297.     if (defined $blocks) {
  298.     $blocks = int(($blocks + 1) / 2);
  299.     }
  300.     else {
  301.     $blocks = int(($size + 1023) / 1024);
  302.     }
  303.  
  304.     if    (-f _) { $perms = '-'; }
  305.     elsif (-d _) { $perms = 'd'; }
  306.     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  307.     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  308.     elsif (-p _) { $perms = 'p'; }
  309.     elsif (-S _) { $perms = 's'; }
  310.     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  311.  
  312.     $tmpmode = $mode;
  313.     $tmp = $rwx[$tmpmode & 7];
  314.     $tmpmode >>= 3;
  315.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  316.     $tmpmode >>= 3;
  317.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  318.     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  319.     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  320.     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  321.     $perms .= $tmp;
  322.  
  323.     $user = $user{$uid} || $uid;
  324.     $group = $group{$gid} || $gid;
  325.  
  326.     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  327.     $moname = $moname[$mon];
  328.     if (-M _ > 365.25 / 2) {
  329.     $timeyear = $year + 1900;
  330.     }
  331.     else {
  332.     $timeyear = sprintf("%02d:%02d", $hour, $min);
  333.     }
  334.  
  335.     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  336.         $ino,
  337.          $blocks,
  338.               $perms,
  339.                 $nlink,
  340.                 $user,
  341.                      $group,
  342.                       $sizemm,
  343.                           $moname,
  344.                          $mday,
  345.                              $timeyear,
  346.                              $pname;
  347.     1;
  348. }
  349.  
  350. sub sizemm {
  351.     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  352. }
  353.  
  354. END
  355. }
  356.  
  357. if ($initcpio) {
  358. print <<'END';
  359. sub cpio {
  360.     local($nc,$fh) = @_;
  361.     local($text);
  362.  
  363.     if ($name eq 'TRAILER!!!') {
  364.     $text = '';
  365.     $size = 0;
  366.     }
  367.     else {
  368.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  369.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  370.     if (-f _) {
  371.         open(IN, "./$_\0") || do {
  372.         warn "Couldn't open $name: $!\n";
  373.         return;
  374.         };
  375.     }
  376.     else {
  377.         $text = readlink($_);
  378.         $size = 0 unless defined $text;
  379.     }
  380.     }
  381.  
  382.     ($nm = $name) =~ s#^\./##;
  383.     $nc{$fh} = $nc;
  384.     if ($nc eq 'n') {
  385.     $cpout{$fh} .=
  386.       sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
  387.         070707,
  388.         $dev & 0777777,
  389.         $ino & 0777777,
  390.         $mode & 0777777,
  391.         $uid & 0777777,
  392.         $gid & 0777777,
  393.         $nlink & 0777777,
  394.         $rdev & 0177777,
  395.         $mtime,
  396.         length($nm)+1,
  397.         $size,
  398.         $nm);
  399.     }
  400.     else {
  401.     $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
  402.     $cpout{$fh} .= pack("SSSSSSSSLSLa*",
  403.         070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
  404.         length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
  405.     }
  406.     if ($text ne '') {
  407.     $cpout{$fh} .= $text;
  408.     }
  409.     elsif ($size) {
  410.     &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
  411.     while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
  412.         &flush($fh);
  413.         $l = length($cpout{$fh});
  414.     }
  415.     }
  416.     close IN;
  417. }
  418.  
  419. sub flush {
  420.     local($fh) = @_;
  421.  
  422.     while (length($cpout{$fh}) >= 5120) {
  423.     syswrite($fh,$cpout{$fh},5120);
  424.     ++$blocks{$fh};
  425.     substr($cpout{$fh}, 0, 5120) = '';
  426.     }
  427. }
  428.  
  429. sub flushall {
  430.     $name = 'TRAILER!!!';
  431.     foreach $fh (keys %cpout) {
  432.     &cpio($nc{$fh},$fh);
  433.     $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
  434.     &flush($fh);
  435.     print $blocks{$fh} * 10, " blocks\n";
  436.     }
  437. }
  438.  
  439. END
  440. }
  441.  
  442. if ($inittar) {
  443. print <<'END';
  444. sub tar {
  445.     local($fh) = @_;
  446.     local($linkname,$header,$l,$slop);
  447.     local($linkflag) = "\0";
  448.  
  449.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  450.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  451.     $nm = $name;
  452.     if ($nlink > 1) {
  453.     if ($linkname = $linkseen{$fh,$dev,$ino}) {
  454.         $linkflag = 1;
  455.     }
  456.     else {
  457.         $linkseen{$fh,$dev,$ino} = $nm;
  458.     }
  459.     }
  460.     if (-f _) {
  461.     open(IN, "./$_\0") || do {
  462.         warn "Couldn't open $name: $!\n";
  463.         return;
  464.     };
  465.     $size = 0 if $linkflag ne "\0";
  466.     }
  467.     else {
  468.     $linkname = readlink($_);
  469.     $linkflag = 2 if defined $linkname;
  470.     $nm .= '/' if -d _;
  471.     $size = 0;
  472.     }
  473.  
  474.     $header = pack("a100a8a8a8a12a12a8a1a100",
  475.     $nm,
  476.     sprintf("%6o ", $mode & 0777),
  477.     sprintf("%6o ", $uid & 0777777),
  478.     sprintf("%6o ", $gid & 0777777),
  479.     sprintf("%11o ", $size),
  480.     sprintf("%11o ", $mtime),
  481.     "        ",
  482.     $linkflag,
  483.     $linkname);
  484.     $l = length($header) % 512;
  485.     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
  486.     substr($header, 154, 1) = "\0";  # blech
  487.     $tarout{$fh} .= $header;
  488.     $tarout{$fh} .= "\0" x (512 - $l) if $l;
  489.     if ($size) {
  490.     &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
  491.     while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
  492.         $slop = length($tarout{$fh}) % 512;
  493.         $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
  494.         &tflush($fh);
  495.         $l = length($tarout{$fh});
  496.     }
  497.     }
  498.     close IN;
  499. }
  500.  
  501. sub tflush {
  502.     local($fh) = @_;
  503.  
  504.     while (length($tarout{$fh}) >= 10240) {
  505.     syswrite($fh,$tarout{$fh},10240);
  506.     ++$blocks{$fh};
  507.     substr($tarout{$fh}, 0, 10240) = '';
  508.     }
  509. }
  510.  
  511. sub tflushall {
  512.     local($len);
  513.  
  514.     foreach $fh (keys %tarout) {
  515.     $len = 10240 - length($tarout{$fh});
  516.     $len += 10240 if $len < 1024;
  517.     $tarout{$fh} .= "\0" x $len;
  518.     &tflush($fh);
  519.     }
  520. }
  521.  
  522. END
  523. }
  524.  
  525. exit;
  526.  
  527. ############################################################################
  528.  
  529. sub tab {
  530.     local($tabstring);
  531.  
  532.     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
  533.     if (!$statdone) {
  534.     if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
  535.         $delayedstat++;
  536.     }
  537.     else {
  538.         if ($saw_or) {
  539.         $tabstring .= <<'ENDOFSTAT' . $tabstring;
  540. ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  541. ENDOFSTAT
  542.         }
  543.         else {
  544.         $tabstring .= <<'ENDOFSTAT' . $tabstring;
  545. (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  546. ENDOFSTAT
  547.         }
  548.         $statdone = 1;
  549.     }
  550.     }
  551.     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
  552.     $tabstring;
  553. }
  554.  
  555. sub fileglob_to_re {
  556.     local($tmp) = @_;
  557.  
  558.     $tmp =~ s#([./^\$()])#\\$1#g;
  559.     $tmp =~ s/([?*])/.$1/g;
  560.     "^$tmp\$";
  561. }
  562.  
  563. sub n {
  564.     local($n) = @_;
  565.  
  566.     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
  567.     $n =~ s/ 0*(\d)/ $1/;
  568.     $n . ')';
  569. }
  570.  
  571. sub quote {
  572.     local($string) = @_;
  573.     $string =~ s/'/\\'/;
  574.     "'$string'";
  575. }
  576.